perm filename SAME.LSP[F76,JMC] blob
sn#261978 filedate 1977-02-06 generic text, type C, neo UTF8
COMMENT ā VALID 00002 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002
C00007 ENDMK
Cā;
(DEFPROP SAMEF (NIL SAMEFRINGE SAME) VALUE)
(DEFUN SAMEFRINGE (X Y)
(OR (AND (NOT (ATOM X))
(NOT (ATOM Y))
(SAME (CAR X) (CAR Y) (CDR X) (CDR Y)))
(EQ X Y)))
(DEFUN SAME (X Y U V)
(OR (AND (NOT (ATOM X))
(NOT (ATOM Y))
(SAME (CAR X)
(CAR Y)
(CONS (CDR X) U)
(CONS (CDR Y) V)))
(AND (NOT (ATOM Y)) (SAME X (CAR Y) U (CONS (CDR Y) V)))
(AND (NOT (ATOM X)) (SAME (CAR X) Y (CONS (CDR X) U) V))
(AND (EQ X Y) (SAMEFRINGE U V))))
(DEFUN SAMEFRINGE1 (X Y)
(OR (EQ X Y)
(AND (NOT (ATOM X))
(NOT (ATOM Y))
(SAME1 (CAR X) (CAR Y) (CDR X) (CDR Y)))))
(DEFUN SAME1 (X Y U V)
(COND ((ATOM X)
(COND ((ATOM Y) (AND (EQ X Y) (SAMEFRINGE1 U V)))
(T (SAME1 X (CAR Y) U (CONS (CDR Y) V)))))
((ATOM Y) (SAME1 (CAR X) Y (CONS (CDR X) U) V))
(T (SAME1 (CAR X)
(CAR Y)
(CONS (CDR X) U)
(CONS (CDR Y) V)))))
(DEFUN SAMEFRINGE2 (X Y) (SAME2 (ABOT (LIST X)) (ABOT (LIST Y))))
(DEFUN SAME2 (U V)
(OR (AND (NULL U) (NULL V))
(AND (NOT (NULL U))
(NOT (NULL V))
(EQ (CAR U) (CAR V))
(SAME2 (NEXT U) (NEXT V)))))
(DEFUN NEXT (U)
(COND ((NULL U) NIL)
((EQ (CADR U) 'A)
(ABOT (CONS (CDADDR U) (CONS 'D (CDDR U)))))
(T (NEXT (CDDR U)))))
(DEFUN ABOT (U)
(COND ((ATOM (CAR U)) U)
(T (ABOT (CONS (CAAR U) (CONS 'A U))))))
(DEFUN SAMEFRINGE3 (X Y)
(OR (EQ X Y)
(AND (NOT (ATOM X))
(NOT (ATOM Y))
((LAMBDA (U V) (AND (EQ (CAR U) (CAR V))
(SAMEFRINGE3 (CDR U) (CDR V))))
(GOPHER X)
(GOPHER Y)))))
(DEFUN GOPHER (U)
(COND ((ATOM (CAR U)) U)
(T (GOPHER (CONS (CAAR U) (CONS (CDAR U) (CDR U)))))))
(DEFUN SAMEFRINGE4 (X Y)
(OR (EQ X Y)
(AND (NOT (ATOM X))
(NOT (ATOM Y))
(SAME4 (GOPHER X) (GOPHER Y)))))
(DEFUN SAME4 (X Y)
(AND (EQ (CAR X) (CAR Y))
(SAMEFRINGE4 (CDR X) (CDR Y))))
(DEFUN SAMEFRINGE5 (X Y)
(COND ((OR (ATOM X) (ATOM Y)) (EQ X Y))
(T ((LAMBDA (W Z) (AND
(EQ (CAR W) (CAR Z))
(SAMEFRINGE5 (CDR W) (CDR Z))))
(GOPHER X) (GOPHER Y)))))
(DEFUN SAMEFRINGE6 (X Y) (OR
(EQ X Y)
(AND (NOT (ATOM X))
(NOT (ATOM Y))
((LAMBDA (W Z) (AND
(EQ (CAR W) (CAR Z))
(SAMEFRINGE6 (CDR W) (CDR Z))))
(GOPHER X) (GOPHER Y)))))